perm filename SIMULA.LSP[SYS,HE] blob
sn#546973 filedate 1982-09-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00020 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 load up files for compilation
C00004 00003 Declarations for the compiler.
C00005 00004 (DEFUN AUTOLD-BIS-SIMULA () NIL)
C00006 00005 clip-time[]
C00007 00006 cmd-*[] doubles $TIME-STEP
C00008 00007 cmd-//[] halves $TIME-STEP
C00009 00008 cmd-a[] skips to the beginning
C00010 00009 cmd-b[] plays backward by 1 step or by # steps
C00013 00010 cmd-f[] plays forward by 1 step or by # steps
C00015 00011 cmd-g[] skips to a given time
C00016 00012 cmd-sf[] skips forward by 1 step or by # steps
C00017 00013 cmd-step[] tells or sets $TIME-STEP
C00018 00014 cmd-time[] reports $TIME.
C00019 00015 cmd-time-hi[]
C00020 00016 cmd-time-lo[]
C00021 00017 cmd-z[]
C00022 00018 compute-time-dependencies[]
C00023 00019 make-time-dependent[exp]
C00024 00020 make-time-independent[exp]
C00025 ENDMK
C⊗;
;;; load up files for compilation
(EVAL-WHEN (COMPILE)
(OR (BOUNDP '|.loaded.|) (FASLOAD LOADER FAS DSK (SYS ROD)))
(LOADUP (RECORD FAS DSK (SYS ROD))
(USEDEC LSP DSK (SYS ROD))
(DECLAR LSP DSK (SYS ROD))
(GRAPHS LSP DSK (SYS ROD))
(BISUTL LSP DSK (SYS BIS))))
;Declarations for the compiler.
(DEFUN AUTOLD-BIS-SIMULA () NIL)
;clip-time[]
;clips $TIME so that
; $TIME-LO < $TIME < $TIME-HI
(DEFUN CLIP-TIME ()
(COND
((> $TIME $TIME-HI)
(SETQ $TIME $TIME-HI)
(WRITELN '|$TIME clipped to $TIME-HI = | $TIME-HI))
((< $TIME $TIME-LO)
(SETQ $TIME $TIME-LO)
(WRITELN '|$TIME clipped to $TIME-LO = | $TIME-LO))
(T NIL))
) ;end-defun
;cmd-*[] doubles $TIME-STEP
(DEFUN CMD-* ()
(SETQ $TIME-STEP (* $TIME-STEP 2))
) ;end-defun
;cmd-//[] halves $TIME-STEP
(DEFUN CMD-// ()
(SETQ $TIME-STEP (// $TIME-STEP 2))
) ;end-defun
;cmd-a[] skips to the beginning
(DEFUN CMD-A ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(IF (OR $NUMBER-BUFFER $SIGN-BUFFER)
THEN (WRITELN '|Illegal: +zA or -zA or #zA or +#zA or -#zA|)
ELSE
(SETQ $TIME $TIME-LO)
(WRITELN '|TIME=| $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF)))
) ;end-defun
;cmd-b[] plays backward by 1 step or by # steps
(DEFUN CMD-B ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN T ELSE NIL)
N ← (IF (NULL $NUMBER-BUFFER)
THEN 1
ELSE (COMPRESS-NUMBER-BUFFER))
THEN BACKWARD ← (NOT FORWARD)
DO
(COND
((AND BACKWARD (= $TIME $TIME-LO))
(BEEP)
(WRITELN '|You're at the end! $TIME-LO = | $TIME-LO))
((AND FORWARD (= $TIME $TIME-HI))
(BEEP)
(WRITELN '|You're at the end! $TIME-HI = | $TIME-HI))
(T
(DO ((I 0 (1+ I)))
((OR (= I N)
(AND BACKWARD (= $TIME $TIME-LO))
(AND FORWARD (= $TIME $TIME-HI))) NIL)
(SETQ $TIME
(IF FORWARD THEN (+ $TIME $TIME-STEP)
ELSE (- $TIME $TIME-STEP)))
(CLIP-TIME)
(WRITELN '|TIME=| $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF))))))
) ;end-defun
;cmd-f[] plays forward by 1 step or by # steps
(DEFUN CMD-F ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN NIL ELSE T)
N ← (IF (NULL $NUMBER-BUFFER)
THEN 1
ELSE (COMPRESS-NUMBER-BUFFER))
THEN BACKWARD ← (NOT FORWARD)
DO
(COND
((AND BACKWARD (= $TIME $TIME-LO))
(BEEP)
(WRITELN '|You're at the end! $TIME-LO = | $TIME-LO))
((AND FORWARD (= $TIME $TIME-HI))
(BEEP)
(WRITELN '|You're at the end! $TIME-HI = | $TIME-HI))
(T
(DO ((I 0 (1+ I)))
((OR (= I N)
(AND BACKWARD (= $TIME $TIME-LO))
(AND FORWARD (= $TIME $TIME-HI))) NIL)
(SETQ $TIME
(IF FORWARD THEN (+ $TIME $TIME-STEP)
ELSE (- $TIME $TIME-STEP)))
(CLIP-TIME)
(WRITELN '|TIME=| $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF))))))
) ;end-defun
;cmd-g[] skips to a given time
(DEFUN CMD-G ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(IF $SIGN-BUFFER
THEN (WRITELN '|Illegal: +#zG or -#zG|)
ELSE
(IF (NULL $NUMBER-BUFFER)
THEN (WRITELN '|Illegal: # must be supplied to zG|)
ELSE
(SETQ $TIME (COMPRESS-NUMBER-BUFFER))
(CLIP-TIME)
(WRITELN '|$TIME = | $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF))))
) ;end-defun
;cmd-sf[] skips forward by 1 step or by # steps
(DEFUN CMD-SF ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(LET FORWARD ← (IF (EQ '- $SIGN-BUFFER) THEN NIL ELSE T)
N ← (IF (NULL $NUMBER-BUFFER)
THEN 1
ELSE (COMPRESS-NUMBER-BUFFER))
DO
(SETQ $TIME
(IF FORWARD THEN (+ $TIME (* N $TIME-STEP))
ELSE (- $TIME (* N $TIME-STEP)))))
(CLIP-TIME)
(WRITELN '|TIME=| $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF))
) ;end-defun
;cmd-step[] tells or sets $TIME-STEP
(DEFUN CMD-STEP ()
(IF (NULL $SIGN-BUFFER)
THEN (LET N ← (COMPRESS-NUMBER-BUFFER)
DO (IF (= 0 N) THEN (WRITELN '|$TIME-STEP=| $TIME-STEP)
ELSE (SETQ $TIME-STEP N)))
ELSE (IF (NULL $NUMBER-BUFFER)
THEN (WRITELN '|Illegal: +zSTEP or -zSTEP|)
ELSE (LET N ← (COMPRESS-NUMBER-BUFFER) DO
(SETQ $TIME-STEP
(IF (EQ '- $SIGN-BUFFER)
THEN (MAX 0 (- $TIME-STEP N))
ELSE (+ $TIME-STEP N))))))
) ;end-defun
;cmd-time[] reports $TIME.
(DEFUN CMD-TIME ()
(WRITELN '|$TIME = | $TIME)
) ;end-defun
;cmd-time-hi[]
;sets $TIME-HI.
(DEFUN CMD-TIME-HI ()
(IF (NULL $NUMBER-BUFFER)
THEN
(WRITELN '|$TIME-HI = | $TIME-HI)
ELSE
(LET N ← (COMPRESS-NUMBER-BUFFER)
THEN
N ← (IF (= $SIGN-BUFFER '-)
THEN (- N)
ELSE N)
DO
(SETQ $TIME-HI N)
(WRITELN '|$TIME-HI = | $TIME-HI)))
) ;end-defun
;cmd-time-lo[]
;sets $TIME-LO.
(DEFUN CMD-TIME-LO ()
(IF (NULL $NUMBER-BUFFER)
THEN
(WRITELN '|$TIME-LO = | $TIME-LO)
ELSE
(LET N ← (COMPRESS-NUMBER-BUFFER)
THEN
N ← (IF (= $SIGN-BUFFER '-)
THEN (- N)
ELSE N)
DO
(SETQ $TIME-LO N)
(WRITELN '|$TIME-LO = | $TIME-LO)))
) ;end-defun
;cmd-z[]
(DEFUN CMD-Z ()
(IF (NOT $TIME-DEPENDENCIES)
THEN
(BEEP)
(WRITELN '|Sorry, but nothing is currently time-dependent.|)
ELSE
(IF (OR $NUMBER-BUFFER $SIGN-BUFFER)
THEN
(WRITELN '|Illegal: +zZ or -zZ or #zZ or +#zZ or -#zZ|)
ELSE
(SETQ $TIME $TIME-HI)
(WRITELN '|TIME=| $TIME)
(COMPUTE-TIME-DEPENDENCIES)
(EVAL $DOSTUFF)))
) ;end-defun
;compute-time-dependencies[]
;EVALs all expressions on the list $TIME-DEPENDENCIES.
(DEFUN COMPUTE-TIME-DEPENDENCIES ()
(FOR EXP ε $TIME-DEPENDENCIES
DO
(EVAL EXP))
) ;end-defun
;make-time-dependent[exp]
;causes EXP to be EVALed whenever $TIME is changed.
(DEFUN MAKE-TIME-DEPENDENT (EXP)
(IF (NOT (MEMBER EXP $TIME-DEPENDENCIES))
THEN
(SETQ $TIME-DEPENDENCIES (CONS EXP $TIME-DEPENDENCIES)))
) ;end-defun
;make-time-independent[exp]
;undoes the MAKE-TIME-DEPENDENT function.
(DEFUN MAKE-TIME-INDEPENDENT (EXP)
(IF (NOT (MEMBER EXP $TIME-DEPENDENCIES))
THEN
(WRITELN '|Sorry, but `|
EXP
'|' is NOT time-dependent.|)
ELSE
(SETQ $TIME-DEPENDENCIES (DELETE EXP $TIME-DEPENDENCIES)))
) ;end-defun